{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  WumpusExpr.ElimLet
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Useless Let elimination for K Normal Form.
--
--------------------------------------------------------------------------------

module WumpusExpr.ElimLet
  (
    
    effect
  , elimLet

  ) where


import WumpusExpr.FreshMon
import WumpusExpr.KNormal

import Control.Applicative
import qualified Data.Set as S


effect :: Expr -> Bool
effect (Val {})                 = False
effect (FunCall {})             = False
effect (Let _ e1 e2)            = effect e1 || effect e2
effect (Ifte _ e1 e2)           = effect e1 || effect e2
effect (Cmd {})                 = True
effect (_ :>> _)                = True
effect (Return {})              = True


--------------------------------------------------------------------------------
-- Useless let elimination

-- anyMembers :: [VarId] -> FreeVars -> Bool
-- anyMembers vs fvs = any (`S.member` fvs) vs

elimLet :: Program -> Mon Program
elimLet (Program main_proc defs) = 
    Program <$> elimLetF main_proc <*> mapM elimLetF defs

elimLetF :: Fundef -> Mon Fundef 
elimLetF (Fundef hd args body) = Fundef hd args <$> elim body


elim :: Expr -> Mon Expr
elim (Let vid e1 e2)            = 
    (\ea eb -> if effect ea || S.member vid (freevars eb)
               then Let vid ea eb else eb) 
      <$> elim e1 <*> elim e2


elim (Ifte v1 e1 e2)            = Ifte v1 <$> elim e1 <*> elim e2

elim (e1 :>> e2)                = (:>>) <$> elim e1 <*> elim e2

elim e                          = return e
